home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1996 #15
/
Monster Media Number 15 (Monster Media)(July 1996).ISO
/
netmail
/
rnr214.zip
/
RNRPROC.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-02-04
|
36KB
|
1,492 lines
unit rnrproc;
{
rnrproc.pas - rnr procedures
}
{$I rnr-def.pas}
interface
uses dos,crt,genericf,rnrglob,rnrconf,rnrfunc,rnrio,rnrfile,
rnrmous,rnrtime,exec;
var
execresult: integer;
execexitcode: integer;
procedure shutdown(exitcode: integer);
procedure msgshutdown(msg: string; exitcode: integer);
procedure warn(warning: string);
procedure warn2(w1,w2: string);
procedure warn3(w1,w2,w3: string);
procedure warnerr(prg: string; doserr: integer);
procedure execp(cmd,cmdline: string);
procedure shellout;
procedure unfoldergroup(var group: string);
procedure pickasource(var trysource: string; var trysourcekind: sourcetype);
procedure updatejoin(highestnum: articlefilenametype);
procedure updatejoinunsubscribe;
procedure updatejoinsubscribe(newgroup: string;
beforegroup: string; aftergroup: string);
procedure addnewmailgroup(newgroup: string);
procedure execviacomspec(cmdline: string);
procedure notquiets(s: string);
procedure notquietlns(s: string);
procedure notquietlnss(s1,s2: string);
procedure addalias(fromheader: string);
procedure maybemkhier(dn: string);
procedure appendencodedfile(destinationfn: string; includedfile: string);
procedure waitnseconds(n: integer);
procedure showaliases(asubstring: string);
procedure showversion;
procedure usershow(showline: string);
procedure getexistingfilename(var afn: string; prompt: string; lastfn: string);
procedure getfilename(var afn: string; prompt: string; lastfn: string);
implementation
procedure addtojoinedgroups(onegroup: string);
begin
if numjoined<maxjoined then
begin
inc(numjoined);
joinedgroups[numjoined] := onegroup;
end;
end;
procedure shutdown;
begin
if joinfn<>'' then
close(joinf);
if haskillfile then
close(killf);
if hasantikillfile then
close(antikillf);
mouseshutdown;
xgotoxy(1,lpp);
xwriteln;
if console then
begin
textattr := oldtextattr;
xwriteln; {so it uses these new (original) colors for sure}
end;
if quitmessage<>'' then
xwritelns(quitmessage);
halt(exitcode);
end;
procedure msgshutdown;
begin
quitmessage := msg;
shutdown(exitcode);
end;
procedure warn;
var
wastec: char;
begin
xclreolxy(1,lpp);
xwritess(copy(warning,1,60),' - press any key ');
wastec := xreadkey;
xclreolxy(1,lpp);
end;
procedure warn2;
begin
xwriteln;
xwriteln;
xclreolxy(1,lpp-2);
xclreolxy(1,lpp-1);
xwrites(w1);
warn(w2);
xclreolxy(1,lpp-2);
xclreolxy(1,lpp-1);
end;
procedure warn3;
begin
xwriteln;
xwriteln;
xwriteln;
xclreolxy(1,lpp-3);
xclreolxy(1,lpp-2);
xwrites(w1);
xclreolxy(1,lpp-1);
xwrites(w2);
warn(w3);
xclreolxy(1,lpp-2);
xclreolxy(1,lpp-1);
end;
procedure warnerr;
var
errstr: string;
begin
errstr := 'unknown #'+itoa(doserr);
if doserr=2 then errstr := '2 (file not found)'
else if doserr=3 then errstr := '3 (path not found)'
else if doserr=5 then errstr := '5 (access denied)'
else if doserr=6 then errstr := '6 (invalid handle)'
else if doserr=8 then errstr := '8 (not enough memory)'
else if doserr=10 then errstr := '10 (invalid environment)'
else if doserr=11 then errstr := '11 (invalid format)'
else if doserr=18 then errstr := '18 (no more files)';
warn('warning: '+prg+' failed (error '+errstr+')');
end;
procedure execp;
var
path: string;
foundapath: boolean;
execed: boolean;
ncmd: string;
nbase: string;
npath: string;
el: string;
at: integer;
function indir(cmd,dir: string): boolean;
var
fileinfo: searchrec;
begin {indir}
findfirst(withbackslash(dir)+cmd,archive,fileinfo);
indir := (doserror=0);
end; {indir}
procedure execswappable(pgm, cmdline: string);
begin {execswappable}
if showdebug('exec') then
begin
xwriteln;
xwritesss('running: pgm="',pgm,'", cmdline="');
xwritelnss(cmdline,'"');
xwriteln;
end;
{
$0000..00FF: The EXECed Program's return code
$0100: Error writing swap file
$0200: Program file not found
$03xx: DOS-error-code xx calling EXEC
$0400: Error allocating environment buffer
}
if swap='' then
execresult := do_exec(pgm, cmdline, 1, $ffff, false)
else if swap='ems' then
execresult := do_exec(pgm, cmdline, 1, $ffff, false)
else if swap='disk' then
execresult := do_exec(pgm, cmdline, -1, $ffff, false)
else if swap='no' then
begin
dos.exec(pgm, cmdline);
execresult := doserror;
if execresult=0 then
execresult := dosexitcode
else
execresult := $300+execresult;
end
else
begin
xwritelns('unknown swap parameter "'+swap+'", so not swapping');
dos.exec(pgm, cmdline);
execresult := doserror;
if execresult=0 then
execresult := dosexitcode
else
execresult := $300+execresult;
end;
if showdebug('exec') then
begin
xwriteln;
xwritelnssss('back from: ',pgm,' ',cmdline);
xwritelnsi('execresult=',execresult);
end;
execexitcode := 0;
if (execresult and $ff00)=0 then
execexitcode := (execresult and $00ff);
{ if there was no error running, return 0 }
{ if there was en error running, report it }
{ otherwise, just leave the error as is (256, 512, 1024 stick out) }
if (execresult and $ff00)=0 then
execresult := 0
else if (execresult and $ff00)=3 then
execresult := (execresult and $00ff);
end; {execswappable}
begin
foundapath := false;
execed := false;
ncmd := unslash(cmd);
nbase := ncmd;
{strip path from nbase}
repeat
at := pos(':',nbase);
if at<>0 then
nbase := copy(nbase,at+1,255);
until at=0;
repeat
at := pos('\',nbase);
if at<>0 then
nbase := copy(nbase,at+1,255);
until at=0;
{chop off path. if trailing \, chop, unless root or drive:root (then add .)}
npath := '';
if nbase<>ncmd then
begin
foundapath := true; {so as to not look further than given path}
npath := copy(ncmd,1,length(ncmd)-length(nbase));
if npath='\' then
npath := npath+'.';
if right(npath,1)=':' then
npath := npath+'.';
if pos(':\',npath)<>0 then
if copy(npath,length(npath)-1,2)=':\' then
npath := npath+'.';
if copy(npath,length(npath),1)='\' then
npath := copy(npath,1,length(npath)-1);
end;
{if an explicit path, use it -- otherwise, just try '.'}
if npath='' then
npath := '.';
{if no extension, try com then exe}
if pos('.',nbase)=0 then
begin
if showdebug('exec') then
xwritelnssss('looking for ',nbase,'.com/.exe in ',npath);
if indir(nbase+'.com',npath) then
begin
foundapath := true;
execed := true;
execswappable(withbackslash(npath)+nbase+'.com',cmdline);
end
else if indir(nbase+'.exe',npath) then
begin
foundapath := true;
execed := true;
execswappable(withbackslash(npath)+nbase+'.exe',cmdline);
end;
end
else if indir(nbase,npath) then
begin
foundapath := true;
execed := true;
execswappable(withbackslash(npath)+nbase,cmdline);
end;
if not foundapath then
begin
{not found in explicit path (or ., if no explicit path). try $PATH}
path := getenv('PATH');
while not foundapath and (path<>'') do
begin
if copy(path,length(path),255)<>';' then
path := path+';';
at := pos(';',path);
el := copy(path,1,at-1);
path := copy(path,at+1,255);
if pos('.',nbase)=0 then
begin
if showdebug('exec') then
xwritelnssss('looking for ',nbase,'.com/.exe in ',el);
if indir(nbase+'.com',el) then
begin
foundapath := true;
execed := true;
execswappable(withbackslash(el)+nbase+'.com',cmdline);
end
else if indir(nbase+'.exe',el) then
begin
foundapath := true;
execed := true;
execswappable(withbackslash(el)+nbase+'.exe',cmdline);
end;
end
else
begin
if showdebug('exec') then
xwritelnssss('looking for ',nbase,' in ',el);
if indir(nbase,el) then
begin
foundapath := true;
execed := true;
execswappable(withbackslash(el)+nbase,cmdline);
end;
end;
end;
end;
if not execed then
begin
warn('could not exec '+cmd+' -- does it exist?');
end;
{$ifdef timeout}
resetidle;
{$endif}
end;
procedure shellout;
var
wastec: char;
begin
if console and trusted then
begin
xgotoxy(1,lpp);
xwriteln;
xwriteln;
xwriteln;
xwritelns('use `EXIT'' to return to rnr');
{it is now impossible to not swap, but this wasn't always true}
if swap='' then
xwritelns('be careful - you do not have much memory available')
else
xwritelns(
'swapped -- you should have most memory available');
xwriteln;
if comspec='' then
begin
warn('could not find what shell to run - no COMSPEC variable');
end
else
begin
mouseshutdown;
execp(comspec,'');
mouseinit;
xgotoxy(1,lpp);
xwriteln;
xwriteln;
xwriteln;
if execresult<>0 then
xwrites('(error) press any key to return to '+newsreadername+' ')
else
xwrites('press any key to return to '+newsreadername+' ');
wastec := xreadkey;
xwrites(^M);
xclreol;
if execresult<>0 then
warnerr('shell',execresult);
end
end;
end;
procedure unfoldergroup;
begin
if length(group)>0 then
if group[1]='=' then
begin
if length(group)=1 then
group := mailprefix
else
group := mailprefix+'.'+copy(group,2,255);
{ prevent possible security hole }
if (numoccur('\',unslash(group))<>0) or
(numoccur(':',group)<>0) or
(pos('..',group)<>0) then
group := mailprefix;
end;
end;
procedure pickasource;
const
baseprompt =
{note: line beyond 80 columns, only due to highlighting toggle chars}
'{j}ump;{a}ll;{1}-{9} pgs;{#};{f}aq;{h}eader/{b}ody/{w}hole;{d}ate;{s}ubj/{n}ame/{e}ither;{+};{-}';
var
shouldsubscribe: char;
wheretoadd: char;
neargroup: string;
neargroupsourcekind: sourcetype;
prompt: string;
howto: char;
tempdate: string;
begin
xclreolxy(1,lpp);
if trysource='' then
begin
xwrites('Goto group, group initials, or directory: ');
trysource := currsource;
{ changed yespreserve to no - it was a pain having to hit ^U to cancel this }
xreadlnse(trysource,cols-30,nopreserve,endkeyswithspace);
{mail folder support}
unfoldergroup(trysource);
end;
if trysource='' then
xclreolxy(1,lpp)
else
if not expandsource(trysource,trysourcekind) then
begin
if getgroupdir(trysource)='' then
begin
warn('could not find a group or directory to match');
trysource := '';
end
else
begin
wheretoadd := 'o';
neargroup := '';
if not quiet then
begin
xclreolxy(1,lpp-4);
xclreolxy(1,lpp-3);
xwrites('to "subscribe" is to add a group to your join file');
xclreolxy(1,lpp-2);
xwrites('which means it will be presented to you each time');
xclreolxy(1,lpp-1);
xwrites('you read news');
end;
shouldsubscribe := onekeydef('subscribe? {y}/{n}','yn','y');
xwrites(shouldsubscribe);
if shouldsubscribe='n' then
trysource := '';
if trysource<>'' then
begin
wheretoadd := onekeydef(
'{^}beginning, {$}end, {-}before or {+}after some group, {o}ops',
'^$-+o','$');
xwrites(wheretoadd);
if wheretoadd='o' then
trysource := '';
end;
if trysource<>'' then
begin
if (wheretoadd='-') or (wheretoadd='+') then
begin
xclreolxy(1,lpp);
if wheretoadd='-' then
xwrites('before what group? ')
else
xwrites('after what group? ');
if currsourcekind=sourcegroup then
neargroup := currsource;
xreadlnse(neargroup,cols-25,yespreserve,endkeyswithspace);
if neargroup='' then
trysource := ''
else
if not expandsource(neargroup,neargroupsourcekind) then
begin
warn('not joined to '+neargroup+
' either -- using beginning');
wheretoadd := '^';
end
else if neargroupsourcekind<>sourcegroup then
begin
warn('not joined to '+neargroup+
' either -- using beginning');
wheretoadd := '^';
end;
end;
end;
{
due to special-casing in updatejoinsubscribe, could
combine ^ with - and $ with +, but I hope this is more clear
}
if trysource<>'' then
begin
xclreolxy(1,lpp);
if wheretoadd='^' then
updatejoinsubscribe(trysource,'','.not-at-end.')
else if wheretoadd='$' then
updatejoinsubscribe(trysource,'.not-at-begin.','')
else if wheretoadd='-' then
updatejoinsubscribe(trysource,neargroup,'.not-at-end.')
else
updatejoinsubscribe(trysource,'.not-at-begin',neargroup);
if not expandsource(trysource,trysourcekind) then
begin
warn('unable to add group!');
trysource := '';
end;
end;
end;
end;
if trysource<>'' then
begin
xclreolxy(1,lpp-1);
xwritelnss('found source: ',trysource);
if not quiet then
begin
xclreolxy(1,lpp-11);
xclreolxy(1,lpp-10);
xwrites(sourcedesc(trysource,trysourcekind));
xclreolxy(1,lpp-9);
xclreolxy(1,lpp-8);
xwritehighlights(
'{j}ump to last position; {a}ll articles; {#} pick start article');
xclreolxy(1,lpp-7);
xwritehighlights(
'{f}requently asked questions;'+
' {h}eader,{b}ody,{w}hole-article searching');
xclreolxy(1,lpp-6);
xwritehighlights(
'{+} no filtering due to `s''een, `k''ill, etc.; {d}ate range');
xclreolxy(1,lpp-5);
xwritehighlights(
'{s}ubject, {n}ame, {e}ither (like {h}eaders, but faster)');
xclreolxy(1,lpp-4);
xwritehighlights(
'{-} show antikilled only');
xclreolxy(1,lpp-3);
xwritehighlights(
'remember, you can just hit {space} to start scanning normally');
xclreolxy(1,lpp-2);
end;
repeat
prompt := '';
if readunfiltered then
prompt := prompt+'+';
if antikilledonly then
prompt := prompt+'-';
if searchinheaders and searchinbody then
prompt := prompt+'w'
else if searchinheaders then
prompt := prompt+'h'
else if searchinbody then
prompt := prompt+'b';
if searchthedate then
prompt := prompt+'d';
if searchinsubj and searchinname then
prompt := prompt+'e'
else if searchinsubj then
prompt := prompt+'s'
else if searchinname then
prompt := prompt+'n';
if prompt='' then
prompt := baseprompt
else
prompt := baseprompt+' '+prompt;
howto := onekeydef(prompt,'ja123456789#hbw+-fdsne','j');
if howto='+' then
readunfiltered := not readunfiltered;
if howto='-' then
antikilledonly := not antikilledonly;
if howto='h' then
searchinheaders := not searchinheaders;
if howto='b' then
searchinbody := not searchinbody;
if howto='w' then {I think this is the best way to toggle this}
begin
searchinheaders := not (searchinheaders or searchinbody);
searchinbody := searchinheaders;
end;
if howto='d' then
searchthedate := not searchthedate;
if howto='s' then
searchinsubj := not searchinsubj;
if howto='n' then
searchinname := not searchinname;
if howto='e' then
begin
searchinsubj := not (searchinsubj or searchinname);
searchinname := searchinsubj;
end;
if searchinsubj or searchinname then
begin
searchinheaders := false;
searchinbody := false;
end;
until (howto<>'+') and
(howto<>'-') and
(howto<>'w') and
(howto<>'h') and
(howto<>'b') and
(howto<>'d') and
(howto<>'n') and
(howto<>'s') and
(howto<>'e');
{ setting it to impossiblylarge will automatically set it to current later }
lowestartsearched := impossiblylargeart;
readpagesback := 0;
{ only groups are in the join file }
if trysourcekind<>sourcegroup then
lowestartsearched := 0;
if howto='#' then
begin
xclreolxy(1,lpp);
xwrites('Start at article number (blank to ignore) ');
xreadlnse(prompt,cols-30,nopreserve,endkeyswithspace);
if prompt<>'' then
begin
lowestartsearched := atol(prompt);
{ we really only search filenames numerically _above_ lowestartsearched }
if lowestartsearched<>0 then
dec(lowestartsearched);
end;
end;
{ for `f' (FAQs), the searching is done for us with a cookie -- don't prompt }
if howto<>'f' then
if searchinheaders or
searchinbody or
searchinsubj or
searchinname then
begin
xclreolxy(1,lpp);
xwrites('Search for: ');
xreadlns(searchtext,cols-30,yespreserve);
if searchtext='' then
searchtext := newsreadername;
end;
if howto='f' then {now reset them to what we want}
begin
searchinheaders := true;
searchinbody := false;
searchinsubj := false;
searchinname := false;
searchtext := faqcookie;
readunfiltered := true;
antikilledonly := false;
lowestartsearched := 0;
end;
if searchthedate then
begin
if not quiet then
begin
xclreolxy(1,lpp-5);
xclreolxy(1,lpp-4);
xwritehighlights(
'if you want no lower bound, use 1900-01-01');
xclreolxy(1,lpp-3);
xwritehighlights(
'if you want no upper bound, use 2020-01-01 or something similar');
xclreolxy(1,lpp-2);
end;
xclreolxy(1,lpp);
xwrites('Date YYYY-MM-DD: earliest: ');
tempdate := datetostring(searchdatelow);
xreadlns(tempdate,cols-30,yespreserve);
if tempdate='' then
tempdate := currentdatestring;
searchdatelow := ymdtodate(tempdate);
xclreolxy(1,lpp);
xwrites('Date YYYY-MM-DD: latest: ');
tempdate := datetostring(searchdatehigh);
xreadlns(tempdate,cols-30,yespreserve);
if tempdate='' then
tempdate := currentdatestring;
searchdatehigh := ymdtodate(tempdate);
end;
if howto='a' then
lowestartsearched := 0;
{ no join file for anything but groups }
if trysourcekind=sourcegroup then
if (howto>='1') and (howto<='9') then
readpagesback := ord(howto)-ord('0');
xclreolxy(1,lpp);
end;
end;
procedure updatejoin;
var
oldcurrsource: string;
groupline: string;
tempf: text;
begin
if currsourcekind=sourcegroup then
begin
oldcurrsource := currsource;
if highestnum>alreadyread then
begin
if quiet then
xwritelns('Updating join file...')
else
xwritelnsss('Updating join file for ',currsource,'...');
assign(tempf,withbackslash(temporarydir)+userid);
rewrite(tempf);
reset(joinf);
while not eof(joinf) do
begin
readln(joinf,groupline);
if getfirstw(groupline)=currsource then
writeln(tempf,currsource,' ',highestnum)
else
writeln(tempf,groupline);
end;
close(joinf);
close(tempf);
reset(tempf);
rewrite(joinf);
while not eof(tempf) do
begin
readln(tempf,groupline);
writeln(joinf,groupline);
end;
close(tempf);
close(joinf);
erase(tempf);
reset(joinf);
end;
currsource := oldcurrsource;
end;
end;
procedure updatejoinunsubscribe;
var
groupline: string;
onegroup: string;
tempf: text;
begin
xwritelns('Updating join file...');
assign(tempf,withbackslash(temporarydir)+userid);
rewrite(tempf);
numjoined := 0;
reset(joinf);
while not eof(joinf) do
begin
readln(joinf,groupline);
onegroup := getfirstw(groupline);
if onegroup<>currsource then
begin
addtojoinedgroups(onegroup);
writeln(tempf,groupline);
end;
end;
close(joinf);
close(tempf);
rewrite(joinf);
reset(tempf);
while not eof(tempf) do
begin
readln(tempf,groupline);
writeln(joinf,groupline);
end;
close(tempf);
close(joinf);
erase(tempf);
reset(joinf);
end;
procedure updatejoinsubscribe;
var
added: boolean;
tempf: text;
groupline: string;
onegroup: string;
begin
added := false;
xwritelns('Updating join file...');
assign(tempf,withbackslash(temporarydir)+userid);
rewrite(tempf);
numjoined := 0;
reset(joinf);
while not eof(joinf) do
begin
readln(joinf,groupline);
onegroup := getfirstw(groupline);
if not added then
begin
if (beforegroup='') and not ismailgroup(onegroup) then
begin
addtojoinedgroups(newgroup);
writeln(tempf,newgroup,' 0');
added := true;
end
else if beforegroup=onegroup then
begin
addtojoinedgroups(newgroup);
writeln(tempf,newgroup,' 0');
added := true;
end;
end;
addtojoinedgroups(onegroup);
writeln(tempf,groupline);
if not added then
begin
if aftergroup=onegroup then
begin
addtojoinedgroups(newgroup);
writeln(tempf,newgroup,' 0');
added := true;
end;
end;
end;
if not added then
begin
addtojoinedgroups(newgroup);
writeln(tempf,newgroup,' 0');
end;
close(joinf);
close(tempf);
rewrite(joinf);
reset(tempf);
while not eof(tempf) do
begin
readln(tempf,groupline);
writeln(joinf,groupline);
end;
close(tempf);
close(joinf);
erase(tempf);
reset(joinf);
end;
procedure addnewmailgroup;
var
added: boolean;
seenmailbutnotnew: boolean;
groupline: string;
onegroup: string;
tempf: text;
begin
added := false;
seenmailbutnotnew := false;
xwritelns('Updating join file...');
assign(tempf,withbackslash(temporarydir)+userid);
rewrite(tempf);
numjoined := 0;
reset(joinf);
while not eof(joinf) do
begin
readln(joinf,groupline);
onegroup := getfirstw(groupline);
if onegroup=mailprefix then
seenmailbutnotnew := true;
{insert the new group alphabetically in the mail groups, or after}
{the last one if it's the biggest alphabetically of them all}
if (seenmailbutnotnew and not ismailgroup(onegroup)) or
(ismailgroup(onegroup) and (onegroup>newgroup)) then
if not added then
begin
added := true;
addtojoinedgroups(newgroup);
writeln(tempf,newgroup,' 0');
seenmailbutnotnew := false;
end;
addtojoinedgroups(onegroup);
writeln(tempf,groupline);
end;
if not added then
begin
addtojoinedgroups(newgroup);
writeln(tempf,newgroup,' 0');
end;
close(joinf);
close(tempf);
rewrite(joinf);
reset(tempf);
while not eof(tempf) do
begin
readln(tempf,groupline);
writeln(joinf,groupline);
end;
close(tempf);
close(joinf);
erase(tempf);
reset(joinf);
end;
procedure execviacomspec;
{mouse shutdown already done, and init will be done soon after}
begin
execp(comspec,'/c '+cmdline);
end;
procedure notquiets;
begin
if not quiet then
xwrites(s);
end;
procedure notquietlns;
begin
if not quiet then
xwritelns(s);
end;
procedure notquietlnss(s1,s2: string);
begin
if not quiet then
xwritelnss(s1,s2);
end;
procedure addalias;
{caller must refresh}
var
aliasaddr: string;
aliasname: string;
aliasdest: char;
aliasfn: string;
aliasf: text;
begin
xclreolxy(1,lpp);
aliasaddr := getfromaddr(fromheader);
xwrites('Address to add to aliases: ');
xreadlnse(aliasaddr,50,yespreserve,endkeyswithspace);
xclreolxy(1,lpp);
if (aliasaddr<>'') then
begin
xwrites('local alias to use for that address: ');
aliasname := lower(getfirstw(getfromname(fromheader)));
xreadlnse(aliasname,cols-40,yespreserve,endkeyswithspace);
xclreolxy(1,lpp);
if aliasname<>'' then
begin
aliasdest := 'p';
if trusted then
begin
aliasdest := onekeydef(
'{p}ersonal or {s}ystem-wide alias, or {q}uit','psq','p');
end
else
begin
aliasdest := onekeydef(
'{p}ersonal alias or {q}uit','pq','p');
end;
if not trusted then
if aliasdest='s' then
aliasdest := 'p';
aliasfn := '';
if aliasdest='p' then
aliasfn := home+'\aliases'
else if aliasdest='s' then
begin
if (xiface=ifacewaffle) or (xiface=ifaceuufree) then
aliasfn := configdir+'\system\'+'aliases'
else if xiface=ifaceuupc then
aliasfn := unslash(getconfig('aliases'));
end;
if aliasfn<>'' then
begin
assign(aliasf,aliasfn);
{$I-}
append(aliasf);
{$I+}
if ioresult<>0 then
{$I-}
rewrite(aliasf);
{$I+}
if ioresult=0 then
begin
writeln(aliasf,aliasname,' ',aliasaddr);
close(aliasf);
end
else
warn('could not create '+aliasfn);
end;
xclreolxy(1,lpp);
end;
end;
end;
procedure maybemkhier;
var
response: char;
begin
if not dexists(dn) then
begin
if not trusted then
begin
xwritelnss(dn,' does not exist -- it must be created first');
shutdown(1);
end;
response :=
onekeydef(dn+' does not exist - create it? {y}/{N}','yNq','y');
if response='y' then
mkhier(dn);
xclreolxy(1,lpp);
if response='q' then
shutdown(1);
end;
end;
procedure appendencodedfile;
var
destinationf: text;
encodedfn: string;
encodebarecmd: string;
encodeparams: string;
encodedf: text;
encodedline: string;
begin
encodedfn := withbackslash(temporarydir)+userid+'.enc';
encodeparams := encodecommand;
encodebarecmd := chopfirstw(encodeparams);
if encodeparams<>'' then
encodeparams := encodeparams+' ';
encodeparams := encodeparams+includedfile+' '+encodedfn;
xwriteln;
xwritelns('encoding...');
execp(encodebarecmd,encodeparams);
{}{}{}{} {check execresult!}
assign(destinationf,destinationfn);
append(destinationf);
safereset(encodedf,encodedfn);
if fileresult<>0 then
writeln(destinationf,'encode failed for '+includedfile)
else
begin
xwritelns('reading...');
while not eof(encodedf) do
begin
readln(encodedf,encodedline);
writeln(destinationf,encodedline);
end;
close(encodedf);
end;
close(destinationf);
end;
{ assumes n<320 or so}
procedure waitnseconds;
var
h,m,s,s00: word;
olds, olds00: word;
starting: word;
s00towait: integer;
begin
if n<320 then
s00towait := n*100
else
s00towait := 32000;
gettime(h,m,olds,olds00);
s := olds;
s00 := olds00;
starting := olds*100+olds00;
while (s*100+s00)<starting+s00towait do
begin
gettime(h,m,s,s00);
if s<olds then
dec(starting,6000); {safer than inc(s,60) to allow for n>59}
end;
end;
procedure showaliases(asubstring: string);
var
aliasfn: string;
currentline: integer;
foundany: boolean;
function showedaliasesin(aliasfn: string; asubstring: string): boolean;
var
result: boolean;
aliasf: text;
done: boolean;
oneline: string;
upsubstring: string;
begin {showedaliasesin}
result := false;
upsubstring := upper(asubstring);
safereset(aliasf,aliasfn);
if fileresult=0 then
begin
done := false;
while not done and not eof(aliasf) do
begin
readln(aliasf,oneline);
if trim(oneline)<>'' then
if (asubstring='') or textintext(upsubstring,upper(oneline)) then
begin
result := true;
xgotoxy(1,currentline);
xwrites(oneline);
inc(currentline);
if currentline>lpp-2 then
begin
done := true;
xclreolxy(1,currentline+1);
xclreolxy(1,currentline);
xwrites('(stopped at one screen)');
end;
end;
end;
close(aliasf);
end;
showedaliasesin := result;
end; {showedaliasesin}
begin
currentline := 2;
foundany := false;
xclrscr;
if (xiface=ifacewaffle) or (xiface=ifaceuufree) then
aliasfn := configdir+'\system\'+'aliases'
else if xiface=ifaceuupc then
aliasfn := unslash(getconfig('aliases'));
if aliasfn<>'' then
foundany := showedaliasesin(aliasfn,asubstring);
if aliasfn<>home+'\aliases' then
begin
aliasfn := home+'\aliases';
foundany := foundany or showedaliasesin(aliasfn,asubstring);
end;
if foundany then
warn('done')
else
if asubstring='' then
warn('no aliases')
else
warn('no aliases matched '+asubstring);
end;
procedure showversion;
begin
warn2('',newsreadername+' '+newsreaderversion+', released '+releasedate);
end;
procedure usershow;
var
mangledshowline: string;
whattoshow: string;
showparameters: string;
begin
mangledshowline := ltrim(trim(showline));
if mangledshowline='' then
begin
warn('show aliases [optional-substring], show time, show version');
end
else
begin
whattoshow := chopfirstw(mangledshowline);
showparameters := mangledshowline;
if partialmatch(whattoshow,'aliases','a') then
begin
showaliases(showparameters);
end
else if partialmatch(whattoshow,'time','t') then {remove this later}
begin
warn('it is now '+currentdatestring+' '+currenttimestring);
end
else if partialmatch(whattoshow,'version','v') then
begin
showversion;
end
else
begin
warn('unknown show object: '+whattoshow);
end;
end;
end;
procedure getexistingfilename;
var
resultfn: string;
resultf: text;
findexistingfileparams: string;
findexistingfilebarecmd: string;
begin
if findexistingfilecommand=builtincookie then
begin
xclreolxy(1,lpp);
xwritess(prompt,' ');
afn := lastfn;
xreadlnse(afn,cols-5-length(prompt),yespreserve,endkeyswithspace);
end
else
begin
resultfn := withbackslash(temporarydir)+userid+'.fil';
findexistingfileparams := findexistingfilecommand;
findexistingfilebarecmd := chopfirstw(findexistingfileparams);
if findexistingfileparams<>'' then
findexistingfileparams := findexistingfileparams+' ';
findexistingfileparams := findexistingfileparams+resultfn;
execp(findexistingfilebarecmd,findexistingfileparams);
{}{}{}{} {check execresult!}
safereset(resultf,resultfn);
if fileresult<>0 then
warn('could not read '+resultfn)
else
begin
if eof(resultf) then
afn := ''
else
readln(resultf,afn);
close(resultf);
end;
end;
end;
procedure getfilename;
var
resultfn: string;
resultf: text;
findfileparams: string;
findfilebarecmd: string;
begin
if findfilecommand=builtincookie then
begin
xclreolxy(1,lpp);
xwritess(prompt,' ');
afn := lastfn;
xreadlnse(afn,cols-5-length(prompt),yespreserve,endkeyswithspace);
end
else
begin
resultfn := withbackslash(temporarydir)+userid+'.fil';
findfileparams := findfilecommand;
findfilebarecmd := chopfirstw(findfileparams);
if findfileparams<>'' then
findfileparams := findfileparams+' ';
findfileparams := findfileparams+resultfn;
execp(findfilebarecmd,findfileparams);
{}{}{}{} {check execresult!}
safereset(resultf,resultfn);
if fileresult<>0 then
warn('could not read '+resultfn)
else
begin
if eof(resultf) then
afn := ''
else
readln(resultf,afn);
close(resultf);
end;
end;
end;
end.